;; Copyright (c) 2022 bobwxc@yeah.net
;; This program is free software: you can redistribute it and/or modify it under
;; the terms of the GNU Lesser General Public License as published by the Free Software
;; Foundation, either version 3 of the License, or (at your option) any later
;; version.
;; This program is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
;; details.
;; You should have received a copy of the GNU General Public License along with
;; this program. If not, see <https://www.gnu.org/licenses/>.

(in-package #:simple-tar)

(defparameter +zero-512-block+
  '(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 0 0 0 0 0 0 0))

(defstruct tar-header
  (name "default"  :type string) ; 100 string
  (mode "0000644" :type string) ; 8
  (uid 1000 :type integer) ; 8 last is 0
  (gid 1001 :type integer) ; 8 last is 0
  (size 0 :type integer) ; 12 last is 0
  (mtime 0 :type integer) ; 12 last is 0
  (chksum 0 :type integer) ; 8 last two are 0 and #x32(or 0)
  (typeflag "0" :type string) ; 1
  (linkname "" :type string) ; 100 string
  (magic "ustar " :type string :read-only t) ; 6 string
  (version " " :type string) ; 2
  (uname "root" :type string) ; 32 string
  (gname "root" :type string) ; 32 string
  (devmajor "" :type string) ; 8
  (devminor "" :type string) ; 8
  (prefix "" :type string) ; 155
  )

(defun number-to-octal-string (num &optional (n 0))
  (declare (integer num)
           (integer n))
  (cond
   ((= n 12) (format nil "~11,'0O" num))
   ((= n 8) (format nil "~7,'0O" num))
   ((= n 6) (format nil "~6,'0O" num))
   (t (format nil "~O" num))
   ))

(defun encode-string (str)
  "string to byte list
   return a list of unsigned-byte 8"
  (declare (string str))
  (u8c:encode-from-string str))

(defun fixed-list (lst len &optional (init-element 0))
  "generate a fixed length list with initial element"
  (let ((l (make-list len :initial-element init-element))
        (min-len (min (length lst) len)))
    (setf (subseq l 0 min-len) (subseq lst 0 min-len))
    l))

(defun gen-bin-header (head)
  "generate tar header in byte list format"
  (declare (tar-header head))
  (let ((bin-list
         (append
          (fixed-list (encode-string (tar-header-name head)) 100 0)
          (fixed-list (encode-string (tar-header-mode head)) 8 0)
          (fixed-list (encode-string (number-to-octal-string (tar-header-uid head) 8)) 8 0)
          (fixed-list (encode-string (number-to-octal-string (tar-header-gid head) 8)) 8 0)
          (fixed-list (encode-string (number-to-octal-string (tar-header-size head) 12)) 12 0)
          (fixed-list (encode-string (number-to-octal-string (tar-header-mtime head) 12)) 12 0)
          (list 32 32 32 32 32 32 32 32) ;; 8 blanks for chksum calculation
          (fixed-list (encode-string (tar-header-typeflag head)) 1 0)
          (fixed-list (encode-string (tar-header-linkname head)) 100 0)
          (fixed-list (encode-string (tar-header-magic head)) 6 0)
          (fixed-list (encode-string (tar-header-version head)) 2 0)
          (fixed-list (encode-string (tar-header-uname head)) 32 0)
          (fixed-list (encode-string (tar-header-gname head)) 32 0)
          (fixed-list (encode-string (tar-header-devmajor head)) 8 0)
          (fixed-list (encode-string (tar-header-devminor head)) 8 0)
          (fixed-list (encode-string (tar-header-prefix head)) 155 0)
          (list 0 0 0 0 0 0 0 0 0 0 0 0) ;; last 12 #x00
          )))
    (setf (tar-header-chksum head) (calcu-chksum bin-list))
    (setf (subseq bin-list 148 156)
          (fixed-list (encode-string (number-to-octal-string (tar-header-chksum head) 6)) 8 0))
    bin-list))

(defun write-one-file (fs head body)
  (declare (tar-header head)
           (list body))
  (write-sequence (gen-bin-header head) fs)
  (write-sequence (fixed-list body
                              (+ (tar-header-size head)
                                 (- 512 (mod (tar-header-size head) 512)))
                              0)
                  fs)
  (write-sequence +zero-512-block+ fs)
  (write-sequence +zero-512-block+ fs)
  )

